home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / m2 / m2_part1.lha / modula / examples / src / sparks.mod < prev   
Text File  |  1994-07-30  |  2KB  |  97 lines
  1. MODULE Sparks (* From oberon version by Fridtjof Siebert, Fred Fish 380 *);
  2.  
  3. IMPORT Graphics{33}, I := Intuition{33} ;
  4.  
  5. FROM SYSTEM IMPORT BITSET, ADDRESS, ADR ;
  6.  
  7. CONST
  8.   maxLines = 64 ;
  9.   erase    = 00 ;
  10.   x       = 00 ;
  11.   y         = 01 ;
  12.   start    = 00 ;
  13.   end       = 01 ;
  14.  
  15. TYPE
  16.   point  = ARRAY [0..01] OF INTEGER ;
  17.   line     = ARRAY [0..01] OF point   ;
  18.   ColArr = ARRAY [0..31] OF INTEGER ;
  19.  
  20. VAR
  21.   i            : INTEGER ;
  22.   ns            : I.NewScreen ;
  23.   screen        : I.ScreenPtr ;
  24.   Ciapra[0BFE001H]    : SET OF [0..7] ;
  25.   lines            : ARRAY [0..maxLines-1] OF line ;
  26.   l            : line ;
  27.   cl            : INTEGER ;
  28.   color,coldir        : INTEGER ;
  29.   deltas        : line ;
  30.   colarr        : ColArr ;
  31.  
  32. PROCEDURE DrawLine( VAR l : line ; color : INTEGER ) ;
  33.   VAR rp : ADDRESS ;
  34. BEGIN
  35.   rp := ADR( screen^.RastPort ) ;
  36.   Graphics.SetAPen( rp , color ) ;
  37.   Graphics.SetDrMd( rp , {} ) ;
  38.   Graphics.Move( rp , l[start,x] , l[start,y] ) ;
  39.   Graphics.Draw( rp , l[end,  x] , l[end,  y] ) ;
  40. END DrawLine;
  41.  
  42. PROCEDURE Adjust( VAR c , dc : INTEGER ; max : INTEGER ) ;
  43.   VAR i : INTEGER ; VHPosR[ 0DFF006H ] : BITSET ;
  44. BEGIN
  45.   i := dc - 8 ;
  46.   INC( c , i ) ;
  47.   IF ( c < 0 ) OR ( c >= max ) THEN
  48.     DEC( c , i ) ;
  49.     i := INTEGER( VHPosR*{0..3} );
  50.     IF i > 7 THEN INC( i , 1 ) END ;
  51.     dc := i ;
  52.   END ;
  53. END Adjust ;
  54.  
  55. PROCEDURE z ;
  56. BEGIN
  57.   WITH ns DO
  58.     Width     := 320 ;
  59.     Height    := 256 ;
  60.     Depth     := 5 ;
  61.     ViewModes := { } ;
  62.     Type      := I.CUSTOMSCREEN + I.SCREENQUIET ;
  63.   END ;
  64.   screen := I.OpenScreen( ns ) ;
  65.   IF screen # NIL THEN
  66.     colarr  := [0000H,0F00H,0F30H,0F60H,0F90H,0FC0H,0FF0H,0CF0H,
  67.         09F0H,06F0H,03F0H,00F0H,00F3H,00F6H,00F9H,00FCH,
  68.         00FFH,00CFH,009FH,006FH,003FH,000FH,030FH,060FH,
  69.         090FH,0C0FH,0F0FH,0F3FH,0F6FH,0F9FH,0FCFH,0FFFH] ;
  70.     Graphics.LoadRGB4( ADR( screen^.ViewPort ) , ADR( colarr ) , 32 ) ;
  71.     color  := 1 ;
  72.     coldir := 1 ;
  73.     REPEAT
  74.       DrawLine( lines[cl] , erase ) ;
  75.       INC( color , coldir ) ;
  76.       IF color = 1 THEN coldir := -coldir
  77.       ELSIF color = 31 THEN coldir := -coldir
  78.       END ;
  79.       CASE color OF 1,31: coldir := -coldir ELSE END ;
  80.       i := start ;
  81.       REPEAT
  82.     Adjust( l[i,x] , deltas[i,x] , screen^.Width ) ;
  83.     Adjust( l[i,y] , deltas[i,y] , screen^.Height ) ;
  84.     INC( i ) ;
  85.       UNTIL i > end ;
  86.       DrawLine( l , color ) ;
  87.       lines[cl] := l ;
  88.       INC( cl ) ;
  89.       IF cl = maxLines THEN cl := 0 END ;
  90.     UNTIL NOT( 6 IN Ciapra ) ;
  91.     I.CloseScreen( screen ) ;
  92.   END
  93. END z ;
  94.  
  95. BEGIN z
  96. END Sparks.
  97.